home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_DBNTX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-26  |  53.4 KB  |  1,304 lines
  1. unit GS_DBNtx;
  2. {-----------------------------------------------------------------------------
  3.                            Clipper Index Handler
  4.  
  5.        GS_DBNtx Copyright (c)  Richard F. Griffin
  6.  
  7.        4 August 1991
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all Clipper index (.NTX)
  14.        operations.  This unit may be implemented by changing the
  15.        GS_DBASE.PAS unit's USES statement from GS_DBNDX to GS_DBNTX.
  16.        That's the only change necessary to replace .NDX indexes with
  17.        Clipper .NTX indexes.
  18.  
  19.        changes:
  20.  
  21.           02 Feb 92 - Added call to KeyLocRec in main part of KeyUpdate.
  22.                       This allows multiple indexes to be used.  In the past,
  23.                       the program assumed the index was pointing to the
  24.                       current record.  There is a sacrifice in update
  25.                       speed, however.
  26.  
  27.           18 Feb 92 - Fixed numerous problems with KeyFind and KeyUpdate.
  28.                       Corrected problem to ensure the first duplicate key
  29.                       is retrieved.  Corrected Index key insertion problem.
  30.  
  31.                       Added KeyBOF flag for test for access beyond top of
  32.                       file.
  33.  
  34.           19 Feb 92 - Embedded cache into Ndx_Get and Ndx_Put.  A number
  35.                       of node images will be stored to memory.  This will
  36.                       be treated as a stack, where the last page accessed
  37.                       will be pushed to the top and new nodes will use the
  38.                       bottom image.  They will replace the old image and
  39.                       push to the top.  This allows the most active nodes to
  40.                       remain in memory, with less active nodes being swapped
  41.                       out.  This also added a Ndx_Flush method to write all
  42.                       updated nodes to disk on demand, such as at closing.
  43.  
  44. ------------------------------------------------------------------------------}
  45.  
  46. interface
  47. {$D-}
  48.  
  49. uses
  50.    GS_Strng,                          {String handler routines}
  51.    GS_Error,                          {Error handler routines}
  52.    GS_FileH;                          {File handler routines}
  53.  
  54. const
  55.    NdxBufSize = 4096;
  56.    IndexSignature = 'NTX';
  57.    NdxBufferedPages = 16;
  58.  
  59. type
  60.  
  61. {
  62.          ┌──────────────────────────────────────────────────────────┐
  63.          │  ********      Index Header Description       ********   │
  64.          └──────────────────────────────────────────────────────────┘
  65. }
  66.    GS_Indx_Head = Record
  67.                      Vers1,
  68.                      Vers2       : Integer;
  69.                      Root        : Longint;
  70.                      Unknwn1     : Longint;
  71.                      Entry_Sz    : Integer;
  72.                      Key_Lgth    : Integer;
  73.                      Unknwn2     : Integer;
  74.                      Max_Keys    : Integer;
  75.                      Min_Keys    : Integer;
  76.                      Key_Form    : array [0..1001] of char;
  77.                   end;
  78.  
  79. {
  80.          ┌──────────────────────────────────────────────────────────┐
  81.          │  ********   Index Node Header Description     ********   │
  82.          └──────────────────────────────────────────────────────────┘
  83. }
  84.  
  85.    GS_Indx_Data = Record              {300 additional bytes for overflow}
  86.                      case integer of
  87.                         0 : (Data_Ary    : array [0..1323] of byte);
  88.                         1 : (Indx_Ary    : array [0..661] of word);
  89.                         2 : (Entry_Ct    : Integer);
  90.                   end;
  91.  
  92.    GS_Indx_EntPtr = ^GS_Indx_Etry;
  93.  
  94.  
  95. {
  96.          ┌──────────────────────────────────────────────────────────┐
  97.          │  ********   Index Node Key Entry Description   *******   │
  98.          └──────────────────────────────────────────────────────────┘
  99. }
  100.  
  101.    GS_Indx_Etry = Record
  102.                      Block_Ax : Longint;
  103.                      Recrd_Ax : Longint;
  104.                      Char_Fld : array [1..255] of char;
  105.                   end;
  106.  
  107.     GS_Indx_Tabl = Record
  108.                       Page_No  : Longint;   {Disk block holding node info}
  109.                       Etry_No  : Longint;   {Last entry used in node}
  110.                       Last_One : Longint;   {Number of keys in this node }
  111.                       Node_Pag : Boolean;   {True for non-leaf nodes}
  112.                    end;
  113.  
  114.    GS_Indx_LPtr = ^GS_dBase_IX;       {Pointer to object.  Used by GS_dBase_DB}
  115.  
  116.    GS_DiskPagPtr = ^GS_DiskPagBfr;
  117.    GS_DiskPagBfr = array[0..1023] of byte;
  118.  
  119.    GS_DiskTblPtr = ^GS_DiskTblPag;
  120.    GS_DiskTblPag = record
  121.       BlkNum : longint;
  122.       BlkWrt : boolean;
  123.       BlkPtr : GS_DiskPagPtr;
  124.    end;
  125.  
  126. {
  127.                       ┌─────────────────────────────────┐
  128.                       │  GS_dBase_IX Object Definition  │
  129.                       └─────────────────────────────────┘
  130. }
  131.  
  132.    GS_dBase_IX = object
  133.       Ndx_Name     : String[64];      {File name of index file}
  134.       Ndx_Hdr      : GS_Indx_Head;    {Index header information}
  135.       Ndx_File     : file;            {File type for index file}
  136.       Ndx_Tabl     : array [0..25] of GS_Indx_Tabl;
  137.                                       {Array of 25 table entries to hold}
  138.                                       {the trail of non-leaf nodes that are}
  139.                                       {traversed during a key search.  This }
  140.                                       {table is needed to track positions for}
  141.                                       {sequential reads (next and previous).}
  142.  
  143.       Ndx_Lvl      : integer;         {Holds counter into Ndx_Tabl}
  144.       Ndx_Data     : GS_Indx_Data;    {Node header information}
  145.       Ndx_Pntr     : GS_Indx_EntPtr;  {Pointer to key entry information}
  146.       Ndx_Key_St   : string[255];     {Holds last key value found on call to}
  147.                                       {either KeyRead or KeyFind}
  148.  
  149.       Ndx_Key_Num  : longint;         {Holds last physical record number for a}
  150.                                       {key value found on call to either}
  151.                                       {KeyRead or KeyFind}
  152.       Ndx_Key_Form : string[127];     {Holds the key formula in type string}
  153.       KeyBOF       : boolean;
  154.       KeyEOF       : boolean;         {True if last KeyRead attempted to read}
  155.                                       {beyond the range of index keys - either}
  156.                                       {beyond beginning or end of file}
  157.       ExactMatch   : boolean;         {Flag for type of test to use in KeyFind}
  158.                                       {It will force a match against an entire}
  159.                                       {key if true, and only for the length of}
  160.                                       {the passed argument if false.  It is}
  161.                                       {initialized true.}
  162.  
  163.       Ndx_PagArray : array[0..NdxBufferedPages-1] of GS_DiskTblPag;
  164.  
  165.       CONSTRUCTOR  Init(IName : String);
  166.       CONSTRUCTOR  Ndx_Make(filname,formla: string;lth: integer;typ: char);
  167.       DESTRUCTOR  Done;
  168.       FUNCTION  KeyFind(st : String) : longint;
  169.       FUNCTION  KeyLocRec(rec : longint) : boolean;
  170.       FUNCTION  KeyRead(a : LongInt) : longint;
  171.       PROCEDURE KeyUpdate (st : string; rec, crec : longint);
  172.       PROCEDURE Ndx_Close;
  173.       Procedure Ndx_Flush;
  174.       PROCEDURE Ndx_Get(blk : longint);
  175.       PROCEDURE Ndx_GetRecEntry;
  176.       PROCEDURE Ndx_GetRecPage(Ascnd : boolean);
  177.       FUNCTION  Ndx_LastEntry : boolean;
  178.       PROCEDURE Ndx_NodeData(pn, en, lo : longint; np : boolean);
  179.       PROCEDURE Ndx_Put(blk : longint);
  180.       Procedure KeyList(st : string);
  181.       FUNCTION  SetMatchValue(st : string): string;
  182.  
  183.  
  184.  
  185.    end;
  186. {.pa}
  187. {
  188.                          ┌──────────────────────────┐
  189.                          │  IMPLEMENTATION SECTION  │
  190.                          └──────────────────────────┘
  191. }
  192.  
  193. implementation
  194.  
  195.  
  196. const
  197.    Node_Size   = 1024; {Size of the node}
  198.  
  199.    Next_Record = -1;   {Token value passed to read next record}
  200.    Prev_Record = -2;   {Token value passed to read previous record}
  201.    Top_Record  = -3;   {Token value passed to read first record}
  202.    Bttm_Record = -4;   {Token value passed to read final record}
  203.  
  204.    ValueHigh   = 1;    {Token value passed for key comparison high}
  205.    ValueLow    = -1;   {Token value passed for key comparison low}
  206.    ValueEqual  = 0;    {Token value passed for key comparison equal}
  207.  
  208. var
  209.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  210.    Work_Num : Double;               {Holds numeric value of Work_Key if needed}
  211.    RPag     : Longint;              {Work variable to hold current index block}
  212.    RNum     : Longint;              {Work variable for record number}
  213.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  214.                                     {Set based on Next/Previous Record read}
  215.  
  216.  
  217. Constructor GS_dBase_IX.Init(IName : String);
  218. var
  219.    i : integer;
  220. begin
  221.    for i := 0 to NdxBufferedPages-1 do
  222.    begin
  223.       Ndx_PagArray[i].BlkNum := -1;
  224.       Ndx_PagArray[i].BlkWrt := false;
  225.       Ndx_PagArray[i].BlkPtr := nil;
  226.    end;
  227.  
  228.    Ndx_Name := IName + '.NTX';
  229.    if GS_FileExists(Ndx_File, Ndx_Name) then
  230.    begin
  231.       GS_FileAssign(Ndx_File,Ndx_Name);
  232.       GS_FileReset(Ndx_File,1);
  233.    end
  234.    else
  235.    begin
  236.       ShowError(2,Ndx_Name);
  237.    end;
  238.    Ndx_Get(0);                        {Read first block of file for header info}
  239.                                       {Note that no error checking is done }
  240.                                       {in this version }
  241.    move(Ndx_Data, Ndx_Hdr, Node_Size);
  242.                                       {Store in header info area}
  243.    Ndx_Lvl := 0;                      {Initialize the node step table}
  244.    Ndx_Tabl[0].Page_No := 0;
  245.    Ndx_Tabl[0].Etry_No := 0;
  246.    Ndx_Tabl[0].Last_One := 0;
  247.    KeyEOF := false;                   {Initialize EOF Flag to false}
  248.    ExactMatch := true;                {Initialize to use an exact match test}
  249.    move(Ndx_Hdr.Key_Form[0], Ndx_Key_Form[1],100);
  250.    i := 1;
  251.    while Ndx_Key_Form[i] <> #0 do inc(i);
  252.    Ndx_Key_Form[0] := chr(pred(i));
  253.    Ndx_Key_Form := TrimR(Ndx_Key_Form);
  254.    Ndx_Key_Form := TrimL(Ndx_Key_Form);
  255. end;
  256.  
  257.  
  258. Destructor GS_dBase_IX.Done;
  259. var
  260.    i : integer;
  261. begin
  262.    Ndx_Close;
  263.    for i := 0 to NdxBufferedPages-1 do
  264.       if Ndx_PagArray[i].BlkPtr <> nil then Dispose(Ndx_PagArray[i].BlkPtr);
  265. end;
  266.  
  267.  
  268. Constructor GS_dBase_IX.Ndx_Make(filname, formla : string; lth : integer;
  269.                                  typ : char);
  270. var
  271.    i : integer;
  272. begin
  273.    for i := 0 to NdxBufferedPages-1 do
  274.    begin
  275.       Ndx_PagArray[i].BlkNum := -1;
  276.       Ndx_PagArray[i].BlkWrt := false;
  277.       Ndx_PagArray[i].BlkPtr := nil;
  278.    end;
  279.  
  280.    Ndx_Name := filname+'.NTX';        {Setup file name}
  281.    GS_FileAssign(Ndx_File,Ndx_Name);
  282.    GS_FileRewrite(Ndx_File,1);
  283.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  284.    Ndx_Hdr.Vers1 := 6;
  285.    Ndx_Hdr.Vers2 := 1;
  286.    Ndx_Hdr.Root := Node_Size;
  287.    Ndx_Hdr.Key_Lgth := lth;
  288.    Ndx_Hdr.Max_Keys := ((SizeOf(Ndx_Hdr)-4) div (lth+10)) - 1;
  289.    Ndx_Hdr.Min_Keys := Ndx_Hdr.Max_Keys div 2;
  290.    Ndx_Hdr.Entry_Sz := lth+8;
  291.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  292.    move(Ndx_Hdr, Ndx_Data, SizeOf(Ndx_Hdr));
  293.    Ndx_Put(0);
  294.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  295.    for i := 0 to Ndx_Hdr.Max_Keys do Ndx_Data.Indx_Ary[succ(i)] :=
  296.                      ((Ndx_Hdr.Max_Keys + 2) * 2) + (Ndx_Hdr.Entry_Sz * i);
  297.    Ndx_Put(1);
  298. end;
  299.  
  300. function GS_dBase_IX.SetMatchValue(st : string): string;
  301. var
  302.    rl : integer;
  303. begin
  304.    FillChar(Work_Key[1], SizeOf(Work_Key), ' '); {Fill with blanks}
  305.    Work_Key := st;
  306.    if ExactMatch then
  307.       Work_Key[0] := chr(Ndx_Hdr.Key_Lgth);
  308.    SetMatchValue := Work_Key;
  309. end;
  310.  
  311. {.pa}
  312. {
  313.                                    KEYFIND
  314.  
  315.  
  316.      ╔══════════════════════════════════════════════════════════════════╗
  317.      ║                                                                  ║
  318.      ║   The KeyFind method will return the physical record location    ║
  319.      ║   of the record matching the key value passed as the argument.   ║
  320.      ║   ExactMatch controls the length of the match check.  If         ║
  321.      ║   ExactMatch is true, the entire key in the .NDX entry must      ║
  322.      ║   match the value passed.  If false, the check will only be      ║
  323.      ║   for the length of the string passed.                           ║
  324.      ║                                                                  ║
  325.      ║       Calling the Method:                                        ║
  326.      ║                                                                  ║
  327.      ║           longintvalu := objectname.KeyFind(string)              ║
  328.      ║                                                                  ║
  329.      ║               ( where objectname is of type GS_dBase_IX,         ║
  330.      ║                       string is a value used to search the       ║
  331.      ║                       .NDX file looking for a match.             ║
  332.      ║                                                                  ║
  333.      ║       Result:                                                    ║
  334.      ║                                                                  ║
  335.      ║       1.  longintvalu will point to the physical record,         ║
  336.      ║           or will be zero if no match.                           ║
  337.      ║       2.  Ndx_Key_St will contain the key value.                 ║
  338.      ║       3.  Ndx_Key_Num will contain the record number.            ║
  339.      ║                                                                  ║
  340.      ╚══════════════════════════════════════════════════════════════════╝
  341. }
  342.  
  343.  
  344. function GS_dBase_IX.KeyFind(st : string) : LongInt;
  345. var
  346.    i         : integer;               {Work variable}
  347.    rl        : integer;               {Result code for Val procedure}
  348.    ct        : integer;               {Variable to hold BlockRead byte count}
  349.    Less_Than : boolean;               {Flag to hunt for key match}
  350.    Loop_Cnt  : longint;
  351.    Match_Cnd : integer;
  352.    NL_Match  : Longint;
  353.  
  354.    procedure StoreMatchValue;
  355.    begin
  356.       move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  357.                                       {Move the key field to Ndx_Key_St.}
  358.       Ndx_Key_St[0] := Work_Key[0];   {Now insert the length into Ndx_Key_St}
  359.    end;
  360.  
  361.    function DoMatchValue : integer;
  362.    begin
  363.       if Ndx_Key_St > Work_Key then Match_Cnd := ValueHigh
  364.          else if Ndx_Key_St = Work_Key then Match_Cnd := ValueEqual
  365.             else Match_Cnd := ValueLow;
  366.       DoMatchValue := Match_Cnd;
  367.    end;
  368.  
  369. begin
  370.    KeyEOF := false;                   {Reset End-of-File to false}
  371.    Ndx_Key_Num := 0;                  {Initialize}
  372.    Ndx_Key_St := '';                  {Initialize}
  373.    Ndx_Lvl := 0;                      {Initialize index level}
  374.    Match_Cnd := ValueLow;
  375.    NL_Match := 0;                     {Non-leaf node key match flag}
  376.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  377.    RPag := Ndx_Hdr.Root div Node_Size;
  378.                                       {Get root node address}
  379.    while (RPag <> 0) do
  380.                                       {While a non-leaf node, do this}
  381.    begin
  382.       Ndx_Get(RPag);                  {Get Node using RPag as block number}
  383.       Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]]);
  384.                                       {Get pointer to first entry}
  385.       Loop_Cnt := Ndx_Pntr^.Block_Ax div Node_Size;
  386.                                       {Get the next node pointer to see if it}
  387.                                       {is zero, meaning a leaf node}
  388.       i := 0;                         {Initialize i as counter}
  389.       Less_Than := Ndx_Data.Entry_Ct > 0;
  390.                                       {Start out with less than flag true}
  391.                                       {Will be false if Entry Count is 0}
  392.                                       {which means an empty node}
  393.       while (less_than) and (i <= Ndx_Data.Entry_Ct) do
  394.                                       {Hunt for a match.  If i = last entry in}
  395.                                       {the node, the last entry is used for}
  396.                                       {the next node search}
  397.       begin
  398.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[i+1]]);
  399.                                       {Get pointer to entry indexed by i}
  400.  
  401.          inc(i);                      {Increment the counter}
  402.          StoreMatchValue;             {Put the key value in Ndx_Key_St for}
  403.                                       {matching}
  404.  
  405.          Less_Than := DoMatchValue = ValueLow;
  406.                                       {Test looking for greater or equal than}
  407.                                       {the key value.  Less_Than will be set}
  408.                                       {false when found, setting the condition}
  409.                                       {to leave this portion of the routine}
  410.  
  411.          if Match_Cnd = ValueEqual then
  412.             NL_Match := Ndx_Pntr^.Recrd_Ax;
  413.       end;
  414. {
  415.                  ┌──────────────────────────────────────────┐
  416.                  │  Save the node data for this node as:    │
  417.                  │  1.  Block Number from RPag.             │
  418.                  │  2.  Entry number of match or last one.  │
  419.                  │  3.  Set total number of entries.  This  │
  420.                  │      is entry count+1 for non-leaf nodes │
  421.                  │  4.  Set non-leaf flag to true.          │
  422.                  └──────────────────────────────────────────┘
  423. }
  424.       Ndx_NodeData(RPag,i,Ndx_Data.Entry_Ct+1,true);
  425.       if Loop_Cnt = 0 then RPag := 0
  426.          else RPag := Ndx_Pntr^.Block_Ax div Node_Size;
  427.                                       {Get the next node in the tree}
  428.    end;
  429.    if RPag = 0 then
  430.    begin
  431.       Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  432.                                       {Set non-leaf flag to false for this}
  433.                                       {last level}
  434.       dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  435.                                       {Set total number of entries to the }
  436.                                       {correct value for a leaf node}
  437.    end;
  438.  
  439.    if Ndx_Data.Entry_Ct = 0 then
  440.    begin
  441.       KeyFind := 0;
  442.       exit;
  443.    end;
  444.  
  445.    if (Match_Cnd <> ValueEqual) or
  446.       (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  447.             then Ndx_Key_Num := 0     {if unable to find a match, the above}
  448.                                       {routine would have stopped when a}
  449.                                       {greater key was found, or would have}
  450.                                       {continued to Last_One.  Since the entry}
  451.                                       {count is one less for leaf nodes, even}
  452.                                       {if there was a match at Last_one, it is}
  453.                                       {not valid, and was only a coincidence.}
  454.                                       {In either case, set record number = 0.}
  455.    else
  456.       Ndx_Key_Num := Ndx_Pntr^.Recrd_Ax;
  457.                                       {When there is a match with the key,}
  458.                                       {get the physical record number}
  459.  
  460.    if (Ndx_Key_Num = 0) and (NL_Match > 0) then
  461.    begin                              {set if match in non-leaf node}
  462.       Ndx_Key_St := Work_Key;
  463.       Ndx_Key_Num := NL_Match;
  464.       dec(Ndx_Lvl);
  465.    end;
  466.  
  467.    KeyFind := Ndx_Key_Num;            {Return with the record number}
  468. end;
  469. {.pa}
  470. {
  471.                                   KEYLOCREC
  472.  
  473.  
  474.      ╔══════════════════════════════════════════════════════════════════╗
  475.      ║                                                                  ║
  476.      ║   The KeyLocRec method will search the .NDX file to find the     ║
  477.      ║   matching index entry pointing to the physical record location  ║
  478.      ║   of the record requested.                                       ║
  479.      ║                                                                  ║
  480.      ║       Calling the Method:                                        ║
  481.      ║                                                                  ║
  482.      ║           flag := objectname.KeyLocRec(key, position)            ║
  483.      ║                                                                  ║
  484.      ║               ( where objectname is of type GS_dBase_IX,         ║
  485.      ║                       key is the key string                      ║
  486.      ║                       position is the physical record number     ║
  487.      ║                          of the matching .DBF record.)           ║
  488.      ║                                                                  ║
  489.      ║       Result:                                                    ║
  490.      ║                                                                  ║
  491.      ║           Boolean True is returned if a match is found.          ║
  492.      ║           The current index entry will be set to the record      ║
  493.      ║           if a match does exist.                                 ║
  494.      ║                                                                  ║
  495.      ╚══════════════════════════════════════════════════════════════════╝
  496. }
  497.  
  498.  
  499. Function GS_dBase_IX.KeyLocRec (rec : longint) : boolean;
  500. var
  501.    lr : longint;
  502. begin
  503.    if rec = Ndx_Key_Num then
  504.    begin                              {Exit if already at the record}
  505.       KeyLocRec := true;
  506.       exit;
  507.    end;
  508.    lr := KeyRead(Top_Record);
  509.    while (not KeyEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  510.    if (KeyEOF) then KeyLocRec := false
  511.       else KeyLocRec := true;
  512. end;
  513. {.pa}
  514. {
  515.                                    KEYREAD
  516.  
  517.  
  518.      ╔══════════════════════════════════════════════════════════════════╗
  519.      ║                                                                  ║
  520.      ║   The KeyRead method will return the physical record location    ║
  521.      ║   of the record requested.  The only options that may be asked   ║
  522.      ║   for are Top, Bottom, Next, and Previous.                       ║
  523.      ║                                                                  ║
  524.      ║       Calling the Method:                                        ║
  525.      ║                                                                  ║
  526.      ║           longintvalu := objectname.KeyRead(position)            ║
  527.      ║                                                                  ║
  528.      ║               ( where objectname is of type GS_dBase_IX,         ║
  529.      ║                       position is in -1 to -4,                   ║
  530.      ║                       longintvalu is physical record number      ║
  531.      ║                          of the matching .DBF record.            ║
  532.      ║                                                                  ║
  533.      ║       Result:                                                    ║
  534.      ║                                                                  ║
  535.      ║           longintvalu will point to the physical record.         ║
  536.      ║                                                                  ║
  537.      ╚══════════════════════════════════════════════════════════════════╝
  538. }
  539.  
  540.  
  541. FUNCTION  GS_dBase_IX.KeyRead(a : longint) : longint;
  542. var
  543.    N_L_Hold   : Integer;              {Tempory variable for index level}
  544.    ct         : Integer;              {Work variable for Blockread count}
  545.  
  546.  
  547.  
  548. {
  549.                ┌───────────────────────────────────────────────┐
  550.                │  Start of KeyRead function.  This will        │
  551.                │  accomplish the following:                    │
  552.                │                                               │
  553.                │  1.  If first time for index, set any call    │
  554.                │      for a Next or Previous read to a Top     │
  555.                │      read command.                            │
  556.                │  2.  Use case select for Top/Bttm/Next/Prev.  │
  557.                │      Return physical .DBF record in RNum.     │
  558.                │  3.  If not a valid action, set RNum to 0.    │
  559.                │  4.  Move key value to Ndx_Key_St.            │
  560.                │  5.  Move RNum to Ndx_Key_Num.                │
  561.                │  6.  Return RNum value to calling procedure.  │
  562.                └───────────────────────────────────────────────┘
  563. }
  564.  
  565.  
  566. { Start of KeyRead }
  567.  
  568. begin
  569.    RNum := a;                         {Get action command}
  570.    if ((a = Next_Record) or (a = Prev_Record)) and
  571.       (Ndx_Lvl = 0) then RNum := Top_Record;
  572.                                       {if first time through, use Top_Record}
  573.                                       {command instead}
  574.    KeyBOF := false;
  575.    KeyEOF := false;                   {End-of-File initially set false}
  576.    case RNum of                       {Select KeyRead Action}
  577.  
  578.       Next_Record : begin
  579.                        IsAscend := true;
  580.                                       {Will be an ascending read}
  581.                        N_L_Hold := Ndx_Lvl;
  582.                                       {Save old index level}
  583. {
  584.                     ┌─────────────────────────────────────┐
  585.                     │  If the last record read was the    │
  586.                     │  last entry in the node, you have   │
  587.                     │  to step back through the index     │
  588.                     │  levels to find the next node.      │
  589.                     └─────────────────────────────────────┘
  590. }
  591.                        if Ndx_LastEntry then
  592.                                       {If last entry in node already used,}
  593.                                       {go find the next node}
  594.                        begin
  595.                           while (Ndx_LastEntry) and (Ndx_Lvl > 0) do
  596.                              dec(Ndx_Lvl);
  597.                                       {Step back through the levels until you}
  598.                                       {find a good one, or run out of levels.}
  599.  
  600.                           if Ndx_Lvl = 0 then
  601.                                       {if out of levels, process for EOF}
  602.                           begin
  603.                              Ndx_Lvl := N_L_Hold;
  604.                                       {Get old level number to restore}
  605.                              KeyEOF := true;
  606.                                       {Set End-of-File true}
  607.                           end else
  608.  
  609.                           begin       {Otherwise, get non-leaf next entry data}
  610.                              RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  611.                              Ndx_Get(RPag);
  612.                           end;
  613.                        end
  614.                        else
  615.                        begin
  616.                           if Ndx_Tabl[Ndx_Lvl].Node_Pag then
  617.                           begin       {this a non-leaf node}
  618.                              inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  619.                                       {Step to next Entry Number}
  620.                              Ndx_GetRecEntry;
  621.                                       {Go search for next good record}
  622.                           end
  623.                           else inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  624.                                       {Otherwise, just step to next entry}
  625.                        end;
  626.                        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  627.                                      [Ndx_Tabl[Ndx_Lvl].Etry_No]]);
  628.                                       {Get pointer to the key entry}
  629.                        RNum := Ndx_Pntr^.Recrd_Ax;
  630.                                       {Get record number for the key entry}
  631.                     end;
  632.  
  633.       Prev_Record : begin
  634.                        IsAscend := false;
  635.                                       {Will be a descending read}
  636.                        N_L_Hold := Ndx_Lvl;
  637.                                       {Save old index level}
  638. {
  639.                     ┌─────────────────────────────────────┐
  640.                     │  If the last record read was the    │
  641.                     │  first entry in the node, you have  │
  642.                     │  to step back through the index     │
  643.                     │  levels to find the next node.      │
  644.                     └─────────────────────────────────────┘
  645. }
  646.                        if Ndx_Tabl[Ndx_Lvl].Node_Pag then
  647.                        begin          {this a non-leaf node}
  648.                           Ndx_GetRecEntry;
  649.                                       {Go search for next good record}
  650.                        end
  651.                        else
  652.                        begin
  653.                           if Ndx_Tabl[Ndx_Lvl].Etry_No = 1 then
  654.                                       {If last entry in node already used,}
  655.                                       {go find the next node}
  656.                           begin
  657.                              while (Ndx_Tabl[Ndx_Lvl].Etry_No = 1) and
  658.                                    (Ndx_Lvl > 0) do dec(Ndx_Lvl);
  659.                                       {Step back through the levels until you}
  660.                                       {find a good one, or run out of levels.}
  661.  
  662.                              if Ndx_Lvl = 0 then
  663.                                       {if out of levels, process for EOF}
  664.                              begin
  665.                                 Ndx_Lvl := N_L_Hold;
  666.                                        {Get old level number to restore}
  667.                                 KeyBOF := true;
  668.                                       {Set Top-of-File true}
  669.                              end else
  670.  
  671.                              begin    {Otherwise, get next entry data}
  672.                                 dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  673.                                       {Step to next Entry Number}
  674.                                 RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  675.                                 Ndx_Get(RPag);
  676.                                       {Go search for next good record}
  677.                              end;
  678.                           end
  679.                           else dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  680.                                       {Otherwise, just step to next entry}
  681.                        end;
  682.                        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  683.                                      [Ndx_Tabl[Ndx_Lvl].Etry_No]]);
  684.                                       {Get pointer to the key entry}
  685.                        RNum := Ndx_Pntr^.Recrd_Ax;
  686.                                       {Get record number for the key entry}
  687.                     end;
  688.  
  689.       Top_Record,
  690.       Bttm_Record : begin
  691.                        IsAscend := Top_Record = RNum;
  692.                                       {Ascending search if Top, otherwise}
  693.                                       {descending.  An ascending search will}
  694.                                       {return the first index key as the Top.}
  695.                                       {A descending search will return the}
  696.                                       {last index key as the 'Top'}
  697.                        Ndx_Lvl := 0;  {Clear index levels for new stack}
  698.                        RPag := Ndx_Hdr.Root div Node_Size;
  699.                                       {Get root node address}
  700.                        Ndx_GetRecPage(IsAscend);
  701.                                       {Go get valid record}
  702.                     end;
  703.  
  704.       else          RNum := 0;        {If no valid action, return zero}
  705.    end;
  706.    move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  707.                                       {Move the key field to Ndx_Key_St.}
  708.                                       {The Move procedure must be used since}
  709.                                       {Char_Fld is not a true Pascal string.}
  710.    Ndx_Key_St[0] := chr(Ndx_Hdr.Key_Lgth);
  711.                                       {Now insert the length into Ndx_Key_St}
  712.                                       {so it is a valid string we can use}
  713.  
  714.    Ndx_Key_Num := RNum;               {Save RNum in Ndx_Key_Num}
  715.    KeyRead := RNum;                   {Return RNum}
  716. end;
  717.  
  718. Procedure GS_dBase_IX.Ndx_Close;
  719. begin
  720.    Ndx_Flush;
  721.    GS_FileClose(Ndx_File);
  722. end;
  723.  
  724.  
  725. Procedure GS_dBase_IX.Ndx_Flush;
  726. var
  727.    r : word;
  728.    v : integer;
  729. begin
  730.    for v := 0 to NdxBufferedPages-1 do
  731.    begin
  732.       if v >= 0 then
  733.       begin
  734.          if Ndx_PagArray[v].BlkWrt then
  735.          begin
  736.             GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*1024,
  737.             Ndx_PagArray[v].BlkPtr^,1024,r);
  738.             if r < 1024 then ShowError(100,'Ndx_Get/Put');
  739.          end;
  740.          Ndx_PagArray[v].BlkWrt := false;
  741.       end;
  742.    end;
  743. end;
  744.  
  745. Procedure GS_dBase_IX.Ndx_Get(blk : longint);
  746. var
  747.    d : GS_DiskTblPag;
  748.    r : word;
  749.    i : integer;
  750.    v : integer;
  751. begin
  752.    v := -1;
  753.    for i := 0 to NdxBufferedPages-1 do
  754.       if Ndx_PagArray[i].BlkNum = blk then v := i;
  755.    if v < 0 then
  756.    begin
  757.       v := NdxBufferedPages-1;
  758.       if Ndx_PagArray[v].BlkWrt then
  759.       begin
  760.          GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*1024,
  761.          Ndx_PagArray[v].BlkPtr^,1024,r);
  762.          if r < 1024 then ShowError(100,'Ndx_Get/Put');
  763.       end;
  764.       Ndx_PagArray[v].BlkNum := blk;
  765.       Ndx_PagArray[v].BlkWrt := false;
  766.       if Ndx_PagArray[v].BlkPtr = nil then New(Ndx_PagArray[v].BlkPtr);
  767.       GS_FileRead(Ndx_File,blk*1024,Ndx_PagArray[v].BlkPtr^,1024,r);
  768.       if r < 1024 then
  769.       begin
  770.          ShowError(100,'Ndx_Get');
  771.       end;
  772.    end;
  773.    d := Ndx_PagArray[v];
  774.    if v <> 0 then move(Ndx_PagArray[0],Ndx_PagArray[1],SizeOf(d)*v);
  775.    Ndx_PagArray[0] := d;
  776.    move(d.BlkPtr^,Ndx_Data,1024);
  777. end;
  778.  
  779.  
  780.  
  781. Procedure GS_dBase_IX.Ndx_NodeData(pn, en, lo : longint; np : boolean);
  782. begin
  783.    inc(Ndx_Lvl);                      {Prepare to store node information as}
  784.                                       {part of the Ndx_Lvl hierarchy}
  785.    with Ndx_Tabl[Ndx_Lvl] do          {Use the index level entry}
  786.    begin
  787.       Page_No := pn;                  {Save Block number}
  788.       Etry_No := en;                  {Set entry number}
  789.       Last_One := lo;                 {Set total number of entries.}
  790.       Node_Pag := np;                 {Set non-leaf flag}
  791.    end;
  792. end;
  793.  
  794.  
  795. procedure GS_dBase_IX.Ndx_GetRecEntry;
  796. begin
  797.    RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  798.                                       {Get page number for this index level}
  799.    Ndx_Get(RPag);                     {Get Node using RPag as block number}
  800.    Ndx_Pntr := Addr
  801.          (Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Ndx_Tabl[Ndx_Lvl].Etry_No]]);
  802.                                       {Get pointer to key entry (relative zero)}
  803.    RPag := Ndx_Pntr^.Block_Ax div Node_Size;
  804.                                       {Get Next node number in RPag}
  805.    Ndx_GetRecPage(IsAscend);          {Go get the next record from a non-leaf}
  806.                                       {node.  Pass the argument for either an}
  807.                                       {ascending or descending search}
  808. end;
  809.  
  810.  
  811. procedure GS_dBase_IX.Ndx_GetRecPage(Ascnd : boolean);
  812. var
  813.    ec : integer;                      {Work variable for entry count}
  814. begin
  815.     while RPag <> 0 do                {Next node number in RPag will be zero}
  816.                                       {when taken from a leaf node.}
  817.     begin
  818.        Ndx_Get(RPag);                 {Get Node using RPag as block number}
  819.        Ndx_NodeData(RPag,0,Ndx_Data.Entry_Ct+1,true);
  820.                                       {Store Node data}
  821.        if Ascnd then
  822.        begin
  823.           ec := 0;                    {Set ec = first entry (relative zero)}
  824.           Ndx_Tabl[Ndx_Lvl].Etry_No := 1;
  825.                                       {Set Entry Number in table to first one}
  826.        end else
  827.        begin
  828.           ec := Ndx_Data.Entry_Ct;    {Set ec to last entry (relative zero)}
  829.                                       {Note there are Entry_Ct+1 entries for}
  830.                                       {non-leaf nodes.  It will be adjusted}
  831.                                       {later if it is a leaf node}
  832.           Ndx_Tabl[Ndx_Lvl].Etry_No := ec+1;
  833.                                       {Set Entry Number in table to last one}
  834.        end;
  835.  
  836.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[ec + 1]]);
  837.                                       {Get pointer to correct entry in node}
  838.        RPag := Ndx_Pntr^.Block_Ax div Node_Size;
  839.                                       {Get Next node number in RPag}
  840.        if (not Ascnd) and (Ndx_Pntr^.Recrd_Ax > 0) then RPag := 0;
  841.                                       {on descend read, process this node}
  842.     end;
  843.     if Ndx_Data.Entry_Ct = 0 then
  844.     begin
  845.        KeyEOF := true;
  846.        RNum := 0;
  847.        exit;
  848.     end;
  849.     Ndx_Tabl[Ndx_Lvl].Node_Pag := Ndx_Pntr^.Block_Ax <> 0;
  850.                                       {Set non-leaf flag to false for this}
  851.                                       {if it is the last level}
  852.     if not Ndx_Tabl[Ndx_Lvl].Node_Pag then
  853.     begin                             {if on a leaf node, adjust}
  854.        if not Ascnd then
  855.        begin
  856.           dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  857.                                       {Set Entry Number in table to last one}
  858.                                       {for a non-leaf node}
  859.           Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[ec]]);
  860.                                       {Get pointer to correct leaf entry for}
  861.                                       {the last entry in the node}
  862.        end;
  863.        dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  864.                                       {Set total number of entries to the }
  865.                                       {correct value for a leaf node}
  866.     end;
  867.     RNum := Ndx_Pntr^.Recrd_Ax;       {Get the physical record number for}
  868.                                       {the first key entry}
  869. end;
  870.  
  871.  
  872. function GS_dBase_IX.Ndx_LastEntry : boolean;
  873. begin
  874.    if Ndx_Tabl[Ndx_Lvl].Etry_No = Ndx_Tabl[Ndx_Lvl].Last_One then
  875.        Ndx_LastEntry := true else Ndx_LastEntry := false;
  876. end;
  877.  
  878. Procedure GS_dBase_IX.Ndx_Put(blk : longint);
  879. var
  880.    d : GS_DiskTblPag;
  881.    r : word;
  882.    i : integer;
  883.    v : integer;
  884. begin
  885.    v := -1;
  886.    for i := 0 to NdxBufferedPages-1 do
  887.       if Ndx_PagArray[i].BlkNum = blk then v := i;
  888.    if v < 0 then
  889.    begin
  890.       v := NdxBufferedPages-1;
  891.       if Ndx_PagArray[v].BlkWrt then
  892.       begin
  893.          GS_FileWrite(Ndx_File,Ndx_PagArray[v].BlkNum*1024,
  894.          Ndx_PagArray[v].BlkPtr^,1024,r);
  895.          if r < 1024 then ShowError(100,'Ndx_Put/Old');
  896.       end;
  897.       Ndx_PagArray[v].BlkNum := blk;
  898.       if Ndx_PagArray[v].BlkPtr = nil then New(Ndx_PagArray[v].BlkPtr);
  899.       GS_FileWrite(Ndx_File,blk*1024,Ndx_Data,1024,r);
  900.       if r < 1024 then ShowError(100,'Ndx_Put/New');
  901.    end;
  902.    d := Ndx_PagArray[v];
  903.    if v <> 0 then move(Ndx_PagArray[0],Ndx_PagArray[1],SizeOf(d)*v);
  904.    d.BlkWrt := true;
  905.    Ndx_PagArray[0] := d;
  906.    move(Ndx_Data,d.BlkPtr^,1024);
  907. end;
  908.  
  909. Procedure GS_dBase_IX.KeyUpdate (st : string; rec, crec : longint);
  910. var
  911.    ForceInsert : boolean;
  912.    ct : integer;
  913.    nu_key : longint;
  914.    em_hold : boolean;                 {holds ExactMatch flag during this}
  915.    t_num  : double;
  916.    lr,
  917.    b1,
  918.    b2,
  919.    pr  : longint;
  920.    rlst,
  921.    e1,
  922.    e2,
  923.    n1,
  924.    n2  : integer;
  925.    s1,
  926.    s2  : string[127];
  927.    r1  : GS_Indx_Data;
  928.  
  929. {
  930.    This routine deletes the current entry by overlaying the remaining entries
  931.    over the entry location, and then decrementing the entry count
  932. }
  933.    Procedure DeleteEntry;
  934.    begin
  935.       with Ndx_Tabl[Ndx_Lvl] do
  936.       begin
  937.          if Etry_No <= Last_One then
  938.          begin
  939.             move(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[succ(Etry_No)]],
  940.                  Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Etry_No]],
  941.                  Ndx_Hdr.Entry_Sz*(Last_One-Etry_No));
  942.             dec(Last_One);
  943.             dec(Ndx_Data.Entry_Ct);
  944.             Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  945.          end;
  946.       end;
  947.    end;
  948.  
  949.  
  950. {  This routine inserts an entry by making room in the current data array
  951.    and inserting the new entry.  The entry count is then incremented.
  952. }
  953.    Procedure InsertEntry;
  954.    begin
  955.       with Ndx_Tabl[Ndx_Lvl] do
  956.       begin
  957.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Last_One]]);
  958.          if (Etry_No <> 0) and (not KeyEOF) and (not ForceInsert) then
  959.          begin                        {If at a valid entry number and not}
  960.                                       {at EOF, make room for the entry.  }
  961.             move(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Etry_No]],
  962.                  Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[succ(Etry_No)]],
  963.                  Ndx_Hdr.Entry_Sz*(((Last_One-Etry_No)+1)));
  964.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Etry_No]]);
  965.          end
  966.          else
  967.          begin                        {else put entry at end of array}
  968.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[Etry_No+1]]);
  969.             inc(Etry_No);
  970.             ForceInsert := false;
  971.          end;
  972.          inc(Last_One);               {account for additional entry}
  973.          inc(Ndx_Data.Entry_Ct);      {account for additional entry}
  974.          move(Work_Key[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth)
  975.                                       {Move the key field from Work_Key.}
  976.                                       {The Move procedure must be used since}
  977.                                       {Char_Fld is not a true Pascal string.}
  978.       end;
  979.    end;
  980.  
  981. {  This routine searches back through the nodes to replace the key value in
  982.    the non-leaf node.
  983. }
  984.    procedure ReplacePointerEntry;
  985.    begin
  986.       while (Ndx_LastEntry) and (Ndx_Lvl > 0) do dec(Ndx_Lvl);
  987.                                       {Search for entry that requires the key}
  988.                                       {value.  Value is not needed for the   }
  989.                                       {last entry in a non-leaf node.  Thus, }
  990.                                       {this searches until it finds a pointer}
  991.                                       {that is not the last entry in a node, }
  992.                                       {or until the root node is reached.    }
  993.       if Ndx_Lvl > 0 then
  994.       begin                           {Replace key value with new one if not }
  995.                                       {the last entry in the root node.      }
  996.          Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  997.                                       {Get the correct index node.}
  998.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  999.                      [Ndx_Tabl[Ndx_Lvl].Etry_No]]);
  1000.                                       {Get entry that pointed to the leaf node}
  1001.          move(Ndx_Key_St[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth);
  1002.                                       {Move the key field from Ndx_Key_St.}
  1003.          Ndx_Pntr^.Recrd_Ax := pr;    {Save the record pointer for the key}
  1004.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1005.                                       {Write updated node to disk}
  1006.       end;
  1007.    end;
  1008.  
  1009.  
  1010. {  This routine is used to delete all references to a record key.  It will
  1011.    delete the key from the leaf node, and then search the non-leaf node and
  1012.    replace the pointer if it was the last entry in the non-leaf node.
  1013. }
  1014.    Procedure KeyDelete;
  1015.    begin
  1016.       DeleteEntry;                    {delete the key from this node.}
  1017.       if Ndx_Tabl[Ndx_Lvl].Last_One = 0 then
  1018.       begin                           {if this was the only entry, then }
  1019.                                       {go delete any previous references}
  1020.                                       {to the node.                     }
  1021.          dec(Ndx_Lvl);
  1022.          if Ndx_Lvl > 0 then
  1023.          begin                        {this will be recursive until it  }
  1024.                                       {steps past the root node.        }
  1025.             Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1026.                                       {Get the node.}
  1027.             KeyDelete;                {and delete the pointer.}
  1028.          end;
  1029.          exit;                        {leave this procedure when all the}
  1030.                                       {references are deleted.          }
  1031.       end;
  1032.  
  1033.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1034.       begin                           {if this was the last entry in the node,}
  1035.                                       {make sure non-leaf node pointers use   }
  1036.                                       {the predecessor key value.             }
  1037.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  1038.                      [Ndx_Tabl[Ndx_Lvl].Last_One]]);
  1039.                                       {point to the predecessor entry.}
  1040.          move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  1041.                                       {Move the key field to Ndx_Key_St.}
  1042.                                       {The Move procedure must be used since}
  1043.                                       {Char_Fld is not a true Pascal string.}
  1044.          Ndx_Key_St[0] := chr(length(Work_Key));
  1045.                                       {Now insert the length into Ndx_Key_St}
  1046.                                       {so it is a valid string we can use}
  1047.          dec(Ndx_Lvl);
  1048.          if Ndx_Lvl > 0 then ReplacePointerEntry;
  1049.                                       {replace node pointer with this new key}
  1050.       end;
  1051.    end;
  1052.  
  1053.    procedure KeyDeleteStart;
  1054.    begin
  1055.       if Ndx_Tabl[Ndx_Lvl].Node_Pag then
  1056.       begin
  1057.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  1058.                                            [Ndx_Tabl[Ndx_Lvl].Etry_No]]);
  1059.          RPag := Ndx_Pntr^.Block_Ax div Node_Size;
  1060.                                       {Get Next node number in RPag}
  1061.          GS_dBase_IX.Ndx_GetRecPage(false);
  1062.          Ndx_Tabl[Ndx_Lvl].Etry_No :=  Ndx_Tabl[Ndx_Lvl].Last_One +1;
  1063.       end;
  1064.       KeyDelete;
  1065.    end;
  1066.  
  1067. {  This routine will divide a block into two equal blocks and then store the
  1068.    index levels (n1 and n2), entry counts (e1 and e2), and block numbers
  1069.    (b1 and b2) for later node pointer updates.  The new key (from the middle
  1070.    of the block's entries) will be saved in s1.
  1071. }
  1072.    Procedure SplitBlock;
  1073.    begin
  1074.       b1 := GS_FileSize(Ndx_File) div Node_Size;
  1075.                                       {Get the next available block.}
  1076.       Ndx_NodeData(b1,1,Ndx_Tabl[Ndx_Lvl].Last_One,Ndx_Tabl[Ndx_Lvl].Node_Pag);
  1077.                                       {make a new index table entry}
  1078.       with Ndx_Tabl[Ndx_Lvl] do
  1079.       begin                           {put the first half of the block in the}
  1080.                                       {new block.  Adjust the entry and last }
  1081.                                       {one counts accordingly.               }
  1082.          n1 := Ndx_Lvl;
  1083.          Ndx_Data.Entry_Ct := Last_One div 2;
  1084.                                       {Number of entries in first half.}
  1085.          e2 := Last_One - Ndx_Data.Entry_Ct;
  1086.                                       {Number of entries in second half.}
  1087.          Last_One := Ndx_Data.Entry_Ct;
  1088.          e1 := Last_One;
  1089.          dec(Ndx_Data.Entry_Ct);
  1090.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary
  1091.                      [Ndx_Tabl[Ndx_Lvl].Last_One]]);
  1092.          move(Ndx_Pntr^.Char_Fld,s1[1],Ndx_Hdr.Key_Lgth);
  1093.          s1[0] := chr(Ndx_Hdr.Key_Lgth);
  1094.          pr := Ndx_Pntr^.Recrd_Ax;
  1095.                                       {Save the last key entry in the block.}
  1096.          Ndx_Put(Page_No);            {Save the block.}
  1097.        end;
  1098.       dec(Ndx_Lvl);
  1099.       with Ndx_Tabl[Ndx_Lvl] do
  1100.       begin
  1101.          b2 := Page_No;
  1102.          n2 := Ndx_Lvl;
  1103.          Last_One := e2;
  1104.          Ndx_Data.Entry_Ct := e2;
  1105.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1106.          move(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[succ(e1)]],
  1107.               Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]],
  1108.               Ndx_Hdr.Entry_Sz*(e2));
  1109.                                       {Shift second half to beginning of the}
  1110.                                       {buffer array.}
  1111.          Ndx_Put(Page_No);            {Save the block}
  1112.          dec(Ndx_Lvl);                {Step back to previous node.}
  1113.       end;
  1114.    end;
  1115.  
  1116.  
  1117. {  This routine is used to create a new root node when the split block
  1118.    pointers will not fit in the current root node.
  1119. }
  1120.    Procedure MakeRootNode;
  1121.    var
  1122.       i : integer;
  1123.    begin
  1124.       Ndx_Lvl := 0;
  1125.       with Ndx_Tabl[Ndx_Lvl] do
  1126.       begin
  1127.          Page_No := GS_FileSize(Ndx_File) div Node_Size;
  1128.                                       {Get the next available block.}
  1129.          Ndx_Hdr.Root := Page_No * Node_Size;
  1130.                                       {Set root pointer to this block.}
  1131.          move(Ndx_Hdr, Ndx_Data, Node_Size);
  1132.                                       {Store from header info area}
  1133.          Ndx_Put(0);                  {Write updated header block.}
  1134.          FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  1135.          for i := 0 to Ndx_Hdr.Max_Keys do Ndx_Data.Indx_Ary[succ(i)] :=
  1136.                      ((Ndx_Hdr.Max_Keys + 2) * 2) + (Ndx_Hdr.Entry_Sz * i);
  1137.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]]);
  1138.          Ndx_Data.Entry_Ct := 0;
  1139.          Ndx_Pntr^.Recrd_Ax := 0;
  1140.          Ndx_Pntr^.Block_Ax := b2 * Node_Size;
  1141.          Last_One := 1;
  1142.          Etry_No := 1;
  1143.          Ndx_Put(Page_No);
  1144.       end;
  1145.    end;
  1146.  
  1147.  
  1148. {  This routine will split the current node, create a new root node if needed,
  1149.    and then insert the newly created block in the proper sequence in the node.
  1150. }
  1151.    procedure ExpandIndex;
  1152.    var
  1153.       kEOF : boolean;
  1154.    begin
  1155.       SplitBlock;
  1156.       if Ndx_Lvl = 0 then MakeRootNode;
  1157.       Work_Key := s1;
  1158.       Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1159.                                       {Get the proper non-leaf node}
  1160.       kEOF := KeyEOF;
  1161.       KeyEOF := false;                {temporarily turn off EOF flag}
  1162.       InsertEntry;
  1163.       KeyEOF := kEOF;
  1164.       Ndx_Pntr^.Recrd_Ax := pr;
  1165.       Ndx_Pntr^.Block_Ax := b1 * Node_Size;
  1166.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1167.                                       {test to see if more entries than the}
  1168.                                       {maximum allowed.                    }
  1169.       begin                           {write the block if below the max.   }
  1170.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1171.       end else
  1172.          ExpandIndex;                 {Keep expanding recursively as long as}
  1173.                                       {is necessary.                        }
  1174.    end;
  1175.  
  1176.  
  1177. {  This routine will insert the new key into the index.  It will search for
  1178.    matching keys and insert the new key after any existing matches.  It will
  1179.    then check to see if the node is filled, and split the block if necessary.
  1180. }
  1181.    Procedure KeyInsert;
  1182.    begin
  1183.       nu_key := KeyFind(st);          {Find a matching key.}
  1184.       if nu_key <> 0 then             {If there is a match, continue looking}
  1185.       begin                           {until no more matches.               }
  1186.          while (Ndx_Key_St = Work_Key) and (not KeyEOF) do
  1187.             nu_key := KeyRead(Next_Record);
  1188.       end;
  1189.       ForceInsert := Ndx_Tabl[Ndx_Lvl].Node_Pag;
  1190.       if ForceInsert then
  1191.       begin
  1192.          while Ndx_Tabl[Ndx_Lvl].Node_Pag do inc(Ndx_Lvl);
  1193.          Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1194.       end;
  1195.       InsertEntry;                    {Insert the key here}
  1196.       Ndx_Pntr^.Recrd_Ax := rec;
  1197.  
  1198.       Ndx_Pntr^.Block_Ax := 0;
  1199.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1200.                                       {if fewer than the maximum number of key}
  1201.                                       {entries allowed, write the updated node}
  1202.       begin
  1203.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1204.       end else
  1205.       begin
  1206.          ExpandIndex;                 {otherwise, split the block.}
  1207.       end;
  1208.    end;
  1209.  
  1210. begin
  1211.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  1212.    if rec = crec then                 {Tests for Append vs Update}
  1213.    begin
  1214.       if KeyLocRec(rec) then
  1215.       begin
  1216.          if Work_Key = Ndx_Key_St then exit;
  1217.          KeyDelete;
  1218.       end;
  1219.    end;
  1220.    em_hold := ExactMatch;
  1221.    ExactMatch := true;
  1222.    KeyInsert;
  1223.    ExactMatch := em_hold;
  1224.    if crec < 0 then exit;
  1225.    lr := KeyFind(st);
  1226.    while lr <> rec do lr := KeyRead(Next_Record);
  1227. end;
  1228.  
  1229.  
  1230.  
  1231. Procedure GS_dBase_IX.KeyList(st : string);
  1232. var
  1233.    ofil      : text;
  1234.    RPag      : LongInt;
  1235.    Lst_One,
  1236.    i,j,k,v   : integer;
  1237.    rl        : integer;
  1238.    ct        : integer;
  1239.    prsz      : integer;
  1240.    recnode,
  1241.    Less_Than : boolean;
  1242.    Fil_Siz   : longint;
  1243. begin
  1244.    assign(ofil, st);
  1245.    ReWrite(ofil);
  1246.    with Ndx_Hdr do
  1247.    fil_siz := GS_FileSize(Ndx_File) div Node_Size;
  1248.    with Ndx_Hdr do
  1249.    begin
  1250.       writeln(ofil,'--------------------------------------------------');
  1251.       writeln(ofil,'File Name = ',Ndx_Name);
  1252.       writeln(ofil,'Key Expression = ',Ndx_Key_Form);
  1253.       writeln(ofil,'Key Length = ',Key_Lgth,
  1254.                    '   Maximum Keys/Block = ',Max_Keys);
  1255.       writeln(ofil,'Root =',Root div Node_Size:3,'   Next Block Available:',
  1256.                    fil_siz:3);
  1257.    end;
  1258.    RPag := 1;
  1259.    prsz := Ndx_Hdr.Key_Lgth;
  1260.    if prsz > 40 then prsz := 40;
  1261.    while RPag <> fil_siz do
  1262.    begin
  1263.       Ndx_Get(RPag);
  1264.       Lst_One := Ndx_Data.Entry_Ct+1;
  1265.       write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct:3,']');
  1266.       Ndx_Pntr := Addr
  1267.          (Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]]);
  1268.       recnode := Ndx_Pntr^.Block_Ax = 0;
  1269.       k := Lst_One;
  1270.       if recnode then dec(k);
  1271.       v := 1;
  1272.       i := 1;
  1273.       while (i <= k) do
  1274.       begin
  1275.          Ndx_Pntr := Addr
  1276.             (Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[i]]);
  1277.          with Ndx_Pntr^ do
  1278.          begin
  1279.             write(ofil,'':v,Block_Ax div node_Size:5);
  1280.             v := 10;
  1281.             if i = Lst_One then write(ofil,'    0 - empty')
  1282.             else
  1283.                begin
  1284.                   write(ofil,Recrd_Ax:5,' ');
  1285.                   for j := 1 to prsz do
  1286.                         write(ofil,Char_Fld[j]);
  1287.                end;
  1288.          WRITELN(OFIL);
  1289.          end;
  1290.          inc(i);
  1291.       end;
  1292.       writeln(ofil);
  1293.       inc(RPag);
  1294.    end;
  1295.    System.Close(ofil);
  1296. end;
  1297.  
  1298. end.
  1299. {-----------------------------------------------------------------------------}
  1300.                                    END
  1301.  
  1302.  
  1303.  
  1304.